#
#  PerlRegex.pm
#  Agate Rule Tester
#
#  Created by Jim Turner on 11/20/05.
#
# License: GNU General Public License
#   This program is free software; you can redistribute it and/or modify it under 
#   the terms of the GNU General Public License as published by the Free Software 
#   Foundation; either version 2 of the License, or (at your option) any later 
#   version.
#
#   This program is distributed in the hope that it will be useful, but WITHOUT 
#   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
#   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 
#   details.
#
#   You should have received a copy of the GNU General Public License along 
#   with this program; if not, write to the Free Software Foundation, Inc., 
#   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
##########################################################################

package PerlRegex;

use CamelBones qw(:All);

use strict;
use warnings;

# DO NOT!! put localized variables in properties... you'll get
#          'selector not recognized' errors and Cocoa won't find
#          your perl object
class PerlRegex {
	'super' => 'NSObject',
	'properties' => [ ],
};

sub init : Selector(init) ReturnType(@)
{
	my( $self ) = @_;
	
	$self = $self->SUPER::init();

	return( $self );
}

sub dealloc : Selector(dealloc) ReturnType()
{
	my( $self ) = @_;

	NSLog( "Deallocating perl's SUPER" );
	$self->SUPER::dealloc();
}

sub parseRegex_onText_exhaustive : Selector(parseRegex:onText:exhaustive:) ReturnType(@) ArgTypes(@@i)
{
	my( $self, $evalString, $text, $exhaustive ) = @_;
	my $ctr = 0;

	if( $exhaustive )
	{
		do
		{
			eval( $evalString );
		} while( $ctr > 0 );
	}
	else
	{
		eval( $evalString );
	}
	
	if( $text eq "" )
	{
		$text = "Pattern Match Removed all Characters";
	}
	
	return( $text );
}

sub replaceLastWithFind_withReplace_onText_caseSensitive : Selector(p_replaceLastWithFind:withReplace:onText:caseSensitive:) ReturnType(@) ArgTypes(@@@i)
{
	my( $self, $findString, $replaceString, $text, $casesensitive ) = @_;
	
	# If the search isn't case-sensitive, we need to upper-case copies of everything
	# and find the positions via those strings.
	my( $ucFindString, $ucText );
	my $pos;
	if( !$casesensitive )
	{
		$ucFindString    = uc( $findString );
		$ucText          = uc( $text );

		$pos = rindex( $ucText, $ucFindString );
	}
	else
	{
		$pos = rindex( $text, $findString );
	}
	
	substr( $text, $pos, length( $findString ) ) = $replaceString;
	
	return( $text );
}

sub matchRegex_onText : Selector(p_matchRegex:onText:) ReturnType(i) ArgTypes(@@)
{
	my( $self, $evalString, $text) = @_;
	my $matchFound;
		
	eval( $evalString );
		
	# Could be zero or one, that's it
	return( $matchFound );
}


sub showDTMnemonics : Selector(p_showDTMnemonics:) ReturnType(@) ArgTypes(@)
{
	my( $self, $text) = @_;

	my $markedText = $self->unicodeToMnemonic( $text );
	
	# To allow for easier-to-read output, add a physical \015 after every [CR]
	# This doesn't affect anything but readability in the Translation Output window.
	$markedText =~ s/(\[CR\])/$1\015/g;
	
	return( $markedText );
}

# ################################################
# Special Character converters
# ################################################

#
# Takes all the [xxx] values and replaces them with unicode values
#
sub mnemonicToUnicode : Selector(p_mnemonicToUnicode:) ReturnType(@) ArgTypes(@)
{
	my( $self, $text ) = @_;

	# 01.03.06 - jturner - We replace [$HEX] items before we do normal mnemonic replacements.
	while( $text =~ /\[\$([0-9A-F][0-9A-F])\]/ )
	{
		my $replacement = pack( 'H2', $1 );

		$text =~ s/\[\$$1\]/$replacement/g;
	}
	
	my %dt2unicode = $self->_DTToUnicodeMap();
	
	foreach my $mnemonic ( keys %dt2unicode )
	{
		# This properly escapes the /'s in the fraction mnemonics
		my $fixedMnemonic = $mnemonic;
		$fixedMnemonic =~ s#/#\\/#g;
	
		my $lookFor     = "\\[$fixedMnemonic\\]";
		my $replaceWith = "\\x{$dt2unicode{$mnemonic}}";
		
		my $regex = "\$text =~ s/$lookFor/$replaceWith/g";
		
		eval( $regex );
	}
	
	return( $text );
}

#
# Takes all unicode values and converts them into DT mnemonics
#
sub unicodeToMnemonic : Selector(p_unicodeToMnemonic:) ReturnType(@) ArgTypes(@)
{
	my( $self, $text ) = @_;
	
	my %dt2unicode = $self->_DTToUnicodeMap();
	
	# Remove [SP]/space from becoming a mnemonic in the output
	delete $dt2unicode{'SP'};
	
	foreach my $mnemonic ( keys %dt2unicode )
	{
		# This properly escapes the /'s in the fraction mnemonics
		my $fixedMnemonic = $mnemonic;
		$fixedMnemonic =~ s#/#\\/#g;
	
		my $lookFor     = "\\x{$dt2unicode{$mnemonic}}";
		my $replaceWith = "[$fixedMnemonic]";
		
		my $regex = "\$text =~ s/$lookFor/$replaceWith/g";
		
		eval( $regex );
	}
	
	return( $text );
}

#
# Takes a subset of the unicode table and converts them into InDesign-friendly
# <0x----> values.
#
sub unicodeToInDesign : Selector(p_unicodeToInDesign:) ReturnType(@) ArgTypes(@)
{
	my( $self, $text ) = @_;
	
	my %unicode2indd = $self->_UnicodeToInDesignMap();
	
	foreach my $unicode ( values %unicode2indd )
	{	
		my $lookFor     = "\\x{$unicode}";
		my $replaceWith = "<0x$unicode>";
		
		my $regex = "\$text =~ s/$lookFor/$replaceWith/g";
		
		eval( $regex );
	}
	
	return( $text );
}

sub extractStoryText : Selector(extractStoryText:) ReturnType(@) ArgTypes(@)
{
	my( $self, $rawText) = @_;
	my $storyText;
	my $matchSuccess;
	
	$matchSuccess = $rawText =~ m/\002([^\003]+)\003/;
	
	# 12.08.05 - jturner - local agate files will not have STX/ETX markers.  So instead of
	#                      having the user tell the program that the file they are loading 
	#                      is in fact a non-Wire file, let's try to figure it out for 
	#					   ourselves.
	if( !$matchSuccess )
	{
		# Does the start of the story not begin with two [SYN] bytes then a [SOH]?  If not,  
		# then this is most likely a local agate file.  If it does (and we didn't match
		# a valid STX/ETX, this file is broken
		if( $rawText =~ m/\026\026\001/ )
		{
			# Hrm... broken AP file.
			$storyText = "ERROR: unable to match start and end of story text";
		}
		else
		{
			# The entire file is most likely the story.  Just save the raw version as
			# the story and see how it goes.
			$storyText = $rawText;
		}
	}
	else
	{
		$storyText = $1;
	}

	return( $storyText );
}

sub escapeRegexCharactersInExpression : Selector(escapeRegexCharactersInExpression:) ReturnType(@) ArgTypes(@)
{
	my( $self, $pattern) = @_;

	# Escape special characters that would normally be considered regular expression
	# characters.  This is important only for find-n-replace items
# This guy never worked right... 
#	$pattern =~ s/\\([^\[\]\d{3,3}xu])/\\\\$1/g;
	$pattern =~ s/\\([^\[\]x])/\\\\$1/g;
	$pattern =~ s/\^/\\\^/g;
	$pattern =~ s/\./\\\./g;
	$pattern =~ s/\+/\\\+/g;
	$pattern =~ s/\{/\\\{/g;
	$pattern =~ s/\}/\\\}/g;
	$pattern =~ s/\(/\\\(/g;
	$pattern =~ s/\)/\\\)/g;
	$pattern =~ s/\?/\\\?/g;
	$pattern =~ s/\*/\\\*/g;
	$pattern =~ s/\=/\\\=/g;
	$pattern =~ s/\//\\\//g;
	$pattern =~ s/\$/\\\$/g;

	return( $pattern );
}

sub escapeRegexCharactersInReplacement : Selector(escapeRegexCharactersInReplacement:) ReturnType(@) ArgTypes(@)
{
	my( $self, $pattern) = @_;

	# Only a couple to really worry about
	# 11.28.05 - jturner - Very very odd... \d{3,3} can't be used below, has to be \d\d\d.  Almost
	#                      like the regex parser will do a 3-character look-ahead and if it finds
	#                      any numeric, it won't match properly.
	$pattern =~ s/\//\\\//g;
#	$pattern =~ s/\\([^\d\d\d])/\\\\$1/g;
	$pattern =~ s/\\([^\[\]x])/\\\\$1/g;
	$pattern =~ s/\$/\\\$/g;

	return( $pattern );
}

sub doRegexTest : Selector(doRegexTest:) ReturnType(@) ArgTypes(@)
{
	my( $self, $evalString) = @_;

	# 12.08.05 - jturner - I've put a damn ; at the end enough now that I need to check
	#                      for it here.
	if( $evalString =~ /\;$/ )
	{
		return( "syntax error: Found semicolon at end of pattern" );
	}

	my $testString = "This is a test string";
	
	eval( $evalString );

	# Return everything eval found as an error... it might be a lot,
	# it might be nothing at all.  Can't combine the chomp and return...
	# chomp returns the number of characters chomped and the calling Cocoa
	# is expecting a string.
	chomp( $@ );
	return( $@ );
}

#
# Methods found below should be considered private to both perl and to the class
# (hence the reason they don't have Selector()s set.)
#

sub _DTToUnicodeMap
{
	my %DTToUnicode = ( 
                 'NUL' => '0000',
                 'SOH' => '0001',
                 'STX' => '0002',
                 'ETX' => '0003',
                 'EOT' => '0004',
                 'ENQ' => '0005',
                 'ACK' => '0006',
                 'BEL' => '0007',
                 'BS' => '0008',
# We call it TAB instead of HT
#                 'HT' => '0009',
                 'TAB' => '0009',
                 'LF' => '000A',
                 'VT' => '000B',
                 'FF' => '000C',
                 'CR' => '000D',
                 'SO' => '000E',
                 'SI' => '000F',
                 'DLE' => '0010',
                 'DC1' => '0011',
                 'DC2' => '0012',
                 'DC3' => '0013',
                 'DC4' => '0014',
                 'NAK' => '0015',
                 'SYN' => '0016',
                 'ETB' => '0017',
                 'CAN' => '0018',
                 'EM' => '0019',
                 'SUB' => '001A',
                 'ESC' => '001B',
                 'FS' => '001C',
                 'GS' => '001D',
                 'RS' => '001E',
                 'US' => '001F',
                 'SP' => '0020',
                 'POUND' => '00A3',
                 'DEGREE' => '00B0',
                 'SECTION' => '00A7',
                 'PARAGRAPH' => '00B6',
                 'COPYRIGHT' => '00A9',
                 'REGISTERED' => '00AE',
                 'TRADEMARK' => '2122',
                 'BULLET' => '2022',
                 'ELLIPSIS' => '2026',
                 'EMDASH' => '2014',
                 'ENDASH' => '2013',
                 'DHYPHEN' => '00AD',
                 'NHYPHEN' => '2011',
                 'EMSPACE' => '2003',
                 'ENSPACE' => '2002',
                 'THINSPACE' => '2009',
                 'HAIRSPACE' => '200A',
                 'FLUSHSPACE' => '2001',
                 'FIGURESPACE' => '2007',
                 'PUNCTSPACE' => '2008',
                 'NBS' => '00A0',
                 'DOUBLEOPEN' => '0093',
                 'DOUBLECLOSE' => '0094',
                 'SINGLEOPEN' => '2018',
                 'SINGLECLOSE' => '2019',
                 'DOUBLEQUOTES' => '0022',
                 'CLOSEQUOTE' => '0027',
                 'OPENQUOTE' => '0060',
                 '1/4' => '00BC',
                 '1/2' => '00BD',
                 '3/4' => '00BE',
                 '1/8' => '215B',
                 '3/8' => '215C',
                 '5/8' => '215D',
                 '7/8' => '215E',
                 'BLANK' => ''
        );
		
	return( %DTToUnicode );
}

sub _UnicodeToInDesignMap
{
    my %UnicodeToInDesign = (
                 'POUND' => '00A3',
                 'DEGREE' => '00B0',
                 'SECTION' => '00A7',
                 'PARAGRAPH' => '00B6',
                 'COPYRIGHT' => '00A9',
                 'REGISTERED' => '00AE',
                 'TRADEMARK' => '2122',
                 'BULLET' => '2022',
                 'ELLIPSIS' => '2026',
                 'EMDASH' => '2014',
                 'ENDASH' => '2013',
                 'DHYPHEN' => '00AD',
                 'NHYPHEN' => '2011',
                 'EMSPACE' => '2003',
                 'ENSPACE' => '2002',
                 'THINSPACE' => '2009',
                 'HAIRSPACE' => '200A',
                 'FLUSHSPACE' => '2001',
                 'FIGURESPACE' => '2007',
                 'PUNCTSPACE' => '2008',
                 'NBS' => '00A0',
                 'DOUBLEOPEN' => '0093',
                 'DOUBLECLOSE' => '0094',
                 'SINGLEOPEN' => '2018',
                 'SINGLECLOSE' => '2019',
                 'DOUBLEQUOTES' => '0022',
                 'CLOSEQUOTE' => '0027',
                 'OPENQUOTE' => '0060',
                 '1/4' => '00BC',
                 '1/2' => '00BD',
                 '3/4' => '00BE',
                 '1/8' => '215B',
                 '3/8' => '215C',
                 '5/8' => '215D',
                 '7/8' => '215E',
        );

	return( %UnicodeToInDesign );
}

1;
